home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / smaltalk.lha / smalltalk-1.1.1 / stix / t.st < prev    next >
Text File  |  1991-09-12  |  3KB  |  132 lines
  1. Smalltalk at: #DebugPrinting put: true!
  2.  
  3. !Object methodsFor: 'debugging'!
  4.  
  5. bugOut: aString
  6.     DebugPrinting 
  7.     ifTrue: [ aString print. self printNl ]
  8. !
  9.  
  10. hexBug: aString
  11.     DebugPrinting 
  12.     ifTrue: [ aString print. self printOn: stdout base: 16. stdout nl ]
  13. !!
  14.  
  15.  
  16. !BlockContext methodsFor: 'fun hacking'!
  17.  
  18. ifDebug
  19.     DebugPrinting ifTrue: [ self value ]
  20. !!
  21.  
  22.  
  23. !String methodsFor: 'converting'!
  24.  
  25. asByteArray
  26.     | bytes i |
  27.     bytes _ ByteArray new: self size.
  28.     i _ 1.
  29.     self do: [ :char | bytes at: i put: (char asciiValue).
  30.                i _ i + 1 ].
  31.     ^bytes
  32. !!
  33.  
  34.  
  35.  
  36. !Display methodsFor: 'anonymous protocol requests'!
  37.  
  38. listFonts: aPattern maxNames: anInteger
  39.     | packet numStrs strs n str |
  40.     packet _ XPacket command: 49.
  41.     socket bytes: (packet word: anInteger; word: aPattern size;
  42.                    bytes: aPattern asByteArray; done).
  43.     socket getReply
  44.     ifFalse: [ ^self ].
  45.     
  46.     numStrs _ socket word.
  47.     socket skipBytes: 22.    "there should be a better way"
  48.     strs _ Array new: numStrs.
  49.     1 to: numStrs do:
  50.     [ :i | n _ socket byte.
  51.            str _ (socket getUnpaddedString: n).
  52.            strs at: i put: str ].
  53.     ^strs
  54. !!
  55.  
  56.  
  57.  
  58. | d s result id title win gc event button tracking pen |
  59.  
  60.     id _ 0.
  61.  
  62.     "Create the initial display connection"
  63.     d _ Display host: '' display: 0.
  64.     d isNil ifTrue: [ ^self error: 'Failed to create display' ].
  65.  
  66.     " Create the root window from the initial display connection"
  67.     RootWindow _ Window new: d id: RootWindowID.
  68.  
  69.     "An example of how to work listFonts:"
  70. "    (d listFonts: '*adobe*normal*' maxNames: 9999) printNl."
  71.  
  72.     s _ d socket.
  73.  
  74.  
  75.     "Create a window that is n bits deep, where n is the default screen depth"
  76.     win _ RootWindow createWindow: 0 
  77.              x: 100 y: 100
  78.              width: 400 height: 200
  79.              borderWidth: 1 class: #CopyFromParent
  80.              visual: #CopyFromParent
  81.              attrs: [ :pack | pack backgroundPixel: WhitePixel;
  82.                       borderPixel: BlackPixel;
  83.                        eventMask: #(Exposure ButtonPress ButtonRelease)
  84.                       ].
  85.  
  86.  
  87.     gc _ win createGC: [ :pack | pack foreground: BlackPixel;
  88.                       background: WhitePixel;
  89.                       "lineWidth: 10;"
  90.                       lineStyle: #Solid ].
  91.  
  92.     " Set the name of the window "
  93.     win changeProperty: #WmName
  94.     type: #String mode: #Replace format: 8 data: Version asByteArray.
  95.  
  96.     " Display the window "
  97.     win mapWindow.
  98.  
  99.     " Get the exposure event "
  100.     s getPacket.
  101.  
  102.     " Draw a nice picture "
  103.     pen _ Pen new: gc.
  104.     pen goto: 150@100.
  105.     pen down.
  106.  
  107.     "This will draw a spiral-like image"
  108. "    1 to: 40 do: [ :i | pen turn: -50.
  109.             pen go: i]."
  110.  
  111.     " Draw a dragon curve "
  112.     pen dragon: 6.
  113.  
  114.     button _ 230 @ 130 extent: 130 @ 40.
  115.  
  116.     " create the rest of the image, including the button "
  117.     gc drawExampleImage: button.
  118.  
  119.     " Wait until a button press event "
  120.     [ event _ s getPacket.
  121.       event class == ButtonPressEvent
  122.       ifTrue: [ (button containsPoint: event eventX @ event eventY) ]
  123.       ] whileFalse.
  124.  
  125.     " Tidy up "
  126.     win destroyWindow.
  127.  
  128. !
  129.  
  130. Smalltalk quitPrimitive!
  131.  
  132.